(defun ciclic-no (a b)
  (and (= (caddr b) (car a)) (= (cadddr b) (cadr a))))

(defun ciclic-digitsp(l)
  (if (null (cdr l)) T
      (and (ciclic-no (car l) (cadr l)) (ciclic-digitsp (cdr l)))))

(defun ciclic-but-last-digitsp(l)
  (if (null (cddr l)) (not (ciclic-no (car l) (cadr l)))
      (and (ciclic-no (car l) (cadr l)) (ciclic-but-last-digitsp (cdr l)))))

(defun valid-sorted(l)
  (ciclic-digitsp l))


(defun valid-sorted-circular(l)
  (and (valid-sorted l)
       (ciclic-no (car (last l)) (car l))))

(defun valid-but-last(l)
  (if (>= 1 (length l)) nil
      (ciclic-but-last-digitsp (mapcar #'digits l))))

(defun valid-circular (l)
  (if (>= 1 (length l)) nil
      (valid-sorted-circular (mapcar #'digits l))))

(defun valid(l)
  (if (>= 1 (length l)) T
      (valid-sorted (sort (mapcar #'digits l) #'ciclic-no))))

(defvar polygonal-list (list #'triangle #'square #'pentagonal #'hexagonal #'heptagonal #'octagonal))

(defun find-first-4digit(func)
  (loop for i = 1 then (1+ i)
       when (< 999 (funcall func i))
       do (return i)))

#|(defun first-solution()
  (loop for i in polygonal 
       for first = (find-first-4digit i)
     collect (list (funcall i first) first i)))|#

(defun first-number(f)
  (list (funcall f (find-first-4digit f)) (find-first-4digit f) f))

(defun next-number(l)
  (list (funcall (caddr l) (1+ (cadr l))) (1+ (cadr l)) (caddr l)))

(defun first-solution(polygonal)
  (mapcar #'first-number polygonal))

(defun next-solution(sol pols size)
;  (print (cons (mapcar #'car sol) size))
  (cond ((null sol) (list (first-number (car pols))))
	((< 10000 (caar sol)) nil)
	((= 1 size) (list (next-number (car sol))))
	((and (not (null (caadr sol)))(< 10000 (caadr sol))) (list (next-number (car sol))))
;	((and (<= 1 size) (null sol)) '((a)));(first-number (car pols))))
	(t (cons (car sol) (next-solution (cdr sol) (cdr pols) (1- size))))))

(defun search-solution(polygonal &optional (sol (first-solution polygonal)) (size (length (first-solution polygonal))))
;  (print (cons "---------------searching----------------" (cons size (mapcar #'car sol))))
;  (if (= 6 (length sol)) (print (mapcar #'cadr sol) ))
;  (print (mapcar #'car sol))
 ; (if (not (valid (mapcar #'car sol))) (print "reduc dimensiunea"))
 ; (if (< (length sol) size) (print "cresc dimensiunea"))
  (cond ((or (null sol) (and (= size (length sol)) (valid-circular (mapcar #'car sol)))) sol)
	((valid-but-last (mapcar #'car sol)) (search-solution polygonal (next-solution sol polygonal (length sol)) size))
	((not (valid (mapcar #'car sol))) (search-solution polygonal (next-solution sol polygonal (1- (length sol))) size))
	((< (length sol) size) (search-solution polygonal (next-solution sol polygonal size) size))
	(t (search-solution polygonal (next-solution sol polygonal size) size))))

(defun probl61()
  (reduce #'+ 
	  (mapcar #'car 
		  (loop for i in (permutations polygonal-list) 
		     for s = (search-solution i) 
		     when (not (null s)) 
		     do (return s)))))

